#' Line plot with optional table

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Line plot with the optional table.

#'

#' @inheritParams argument_convention

#' @param alt_counts_df (`data.frame` or `NULL`)\cr data set that will be used (only)

#'   to counts objects in groups for stratification.

#' @param variables (named `character`) vector of variable names in `df` which should include:

#'   * `x` (`string`)\cr name of x-axis variable.

#'   * `y` (`string`)\cr name of y-axis variable.

#'   * `group_var` (`string` or `NULL`)\cr name of grouping variable (or strata), i.e. treatment arm.

#'     Can be `NA` to indicate lack of groups.

#'   * `subject_var` (`string` or `NULL`)\cr name of subject variable. Only applies if `group_var` is

#'      not NULL.

#'   * `paramcd` (`string` or `NA`)\cr name of the variable for parameter's code. Used for y-axis label and plot's

#'     subtitle. Can be `NA` if `paramcd` is not to be added to the y-axis label or subtitle.

#'   * `y_unit` (`string` or `NA`)\cr name of variable with units of `y`. Used for y-axis label and plot's subtitle.

#'     Can be `NA` if y unit is not to be added to the y-axis label or subtitle.

#'   * `facet_var` (`string` or `NA`)\cr name of the secondary grouping variable used for plot faceting, i.e. treatment

#'     arm. Can be `NA` to indicate lack of groups.

#' @param mid (`character` or `NULL`)\cr names of the statistics that will be plotted as midpoints.

#'   All the statistics indicated in `mid` variable must be present in the object returned by `sfun`,

#'   and be of a `double` or `numeric` type vector of length one.

#' @param interval (`character` or `NULL`)\cr names of the statistics that will be plotted as intervals.

#'   All the statistics indicated in `interval` variable must be present in the object returned by `sfun`,

#'   and be of a `double` or `numeric` type vector of length two. Set `interval = NULL` if intervals should not be

#'   added to the plot.

#' @param whiskers (`character`)\cr names of the interval whiskers that will be plotted. Names must match names

#'   of the list element `interval` that will be returned by `sfun` (e.g. `mean_ci_lwr` element of

#'   `sfun(x)[["mean_ci"]]`). It is possible to specify one whisker only, or to suppress all whiskers by setting

#'   `interval = NULL`.

#' @param table (`character` or `NULL`)\cr names of the statistics that will be displayed in the table below the plot.

#'   All the statistics indicated in `table` variable must be present in the object returned by `sfun`.

#' @param sfun (`function`)\cr the function to compute the values of required statistics. It must return a named `list`

#'   with atomic vectors. The names of the `list` elements refer to the names of the statistics and are used by `mid`,

#'   `interval`, `table`. It must be able to accept as input a vector with data for which statistics are computed.

#' @param ... optional arguments to `sfun`.

#' @param mid_type (`string`)\cr controls the type of the `mid` plot, it can be point (`"p"`), line (`"l"`),

#'   or point and line (`"pl"`).

#' @param mid_point_size (`numeric(1)`)\cr font size of the `mid` plot points.

#' @param position (`character` or `call`)\cr geom element position adjustment, either as a string, or the result of

#'   a call to a position adjustment function.

#' @param legend_title (`string`)\cr legend title.

#' @param legend_position (`string`)\cr the position of the plot legend (`"none"`, `"left"`, `"right"`, `"bottom"`,

#'   `"top"`, or a two-element numeric vector).

#' @param ggtheme (`theme`)\cr a graphical theme as provided by `ggplot2` to control styling of the plot.

#' @param xticks (`numeric` or `NULL`)\cr numeric vector of tick positions or a single number with spacing

#'   between ticks on the x-axis, for use when `variables$x` is numeric. If `NULL` (default), [labeling::extended()] is

#'   used to determine optimal tick positions on the x-axis. If `variables$x` is not numeric, this argument is ignored.

#' @param x_lab (`string` or `NULL`)\cr x-axis label. If `NULL` then no label will be added.

#' @param y_lab (`string` or `NULL`)\cr y-axis label. If `NULL` then no label will be added.

#' @param y_lab_add_paramcd (`flag`)\cr whether `paramcd`, i.e. `unique(df[[variables["paramcd"]]])` should be added

#'   to the y-axis label (`y_lab`).

#' @param y_lab_add_unit (`flag`)\cr whether y-axis unit, i.e. `unique(df[[variables["y_unit"]]])` should be added

#'   to the y-axis label (`y_lab`).

#' @param title (`string`)\cr plot title.

#' @param subtitle (`string`)\cr plot subtitle.

#' @param subtitle_add_paramcd (`flag`)\cr whether `paramcd`, i.e. `unique(df[[variables["paramcd"]]])` should be

#'   added to the plot's subtitle (`subtitle`).

#' @param subtitle_add_unit (`flag`)\cr whether the y-axis unit, i.e. `unique(df[[variables["y_unit"]]])` should be

#'   added to the plot's subtitle (`subtitle`).

#' @param caption (`string`)\cr optional caption below the plot.

#' @param table_format (named `character` or `NULL`)\cr format patterns for descriptive statistics used in the

#'   (optional) table appended to the plot. It is passed directly to the `h_format_row` function through the `format`

#'   parameter. Names of `table_format` must match the names of statistics returned by `sfun` function.

#' @param table_labels (named `character` or `NULL`)\cr labels for descriptive statistics used in the (optional) table

#'   appended to the plot. Names of `table_labels` must match the names of statistics returned by `sfun` function.

#' @param table_font_size (`numeric(1)`)\cr font size of the text in the table.

#' @param newpage `r lifecycle::badge("deprecated")` not used.

#' @param col (`character`)\cr color(s). See `?ggplot2::aes_colour_fill_alpha` for example values.

#' @param linetype (`character`)\cr line type(s). See `?ggplot2::aes_linetype_size_shape` for example values.

#' @param errorbar_width (`numeric(1)`)\cr width of the error bars.

#'

#' @return A `ggplot` line plot (and statistics table if applicable).

#'

#' @examples

#' library(nestcolor)

#'

#' adsl <- tern_ex_adsl

#' adlb <- tern_ex_adlb %>% dplyr::filter(ANL01FL == "Y", PARAMCD == "ALT", AVISIT != "SCREENING")

#' adlb$AVISIT <- droplevels(adlb$AVISIT)

#' adlb <- dplyr::mutate(adlb, AVISIT = forcats::fct_reorder(AVISIT, AVISITN, min))

#'

#' # Mean with CI

#' g_lineplot(adlb, adsl, subtitle = "Laboratory Test:")

#'

#' # Mean with CI, no stratification with group_var

#' g_lineplot(adlb, variables = control_lineplot_vars(group_var = NA))

#'

#' # Mean, upper whisker of CI, no group_var(strata) counts N

#' g_lineplot(

#'   adlb,

#'   whiskers = "mean_ci_upr",

#'   title = "Plot of Mean and Upper 95% Confidence Limit by Visit"

#' )

#'

#' # Median with CI

#' g_lineplot(

#'   adlb,

#'   adsl,

#'   mid = "median",

#'   interval = "median_ci",

#'   whiskers = c("median_ci_lwr", "median_ci_upr"),

#'   title = "Plot of Median and 95% Confidence Limits by Visit"

#' )

#'

#' # Mean, +/- SD

#' g_lineplot(adlb, adsl,

#'   interval = "mean_sdi",

#'   whiskers = c("mean_sdi_lwr", "mean_sdi_upr"),

#'   title = "Plot of Median +/- SD by Visit"

#' )

#'

#' # Mean with CI plot with stats table

#' g_lineplot(adlb, adsl, table = c("n", "mean", "mean_ci"))

#'

#' # Mean with CI, table and customized confidence level

#' g_lineplot(

#'   adlb,

#'   adsl,

#'   table = c("n", "mean", "mean_ci"),

#'   control = control_analyze_vars(conf_level = 0.80),

#'   title = "Plot of Mean and 80% Confidence Limits by Visit"

#' )

#'

#' # Mean with CI, table, filtered data

#' adlb_f <- dplyr::filter(adlb, ARMCD != "ARM A" | AVISIT == "BASELINE")

#' g_lineplot(adlb_f, table = c("n", "mean"))

#'

#' @export

g_lineplot <- function(df,

                       alt_counts_df = NULL,

                       variables = control_lineplot_vars(),

                       mid = "mean",

                       interval = "mean_ci",

                       whiskers = c("mean_ci_lwr", "mean_ci_upr"),

                       table = NULL,

                       sfun = s_summary,

                       ...,

                       mid_type = "pl",

                       mid_point_size = 2,

                       position = ggplot2::position_dodge(width = 0.4),

                       legend_title = NULL,

                       legend_position = "bottom",

                       ggtheme = nestcolor::theme_nest(),

                       xticks = NULL,

                       xlim = NULL,

                       ylim = NULL,

                       x_lab = obj_label(df[[variables[["x"]]]]),

                       y_lab = NULL,

                       y_lab_add_paramcd = TRUE,

                       y_lab_add_unit = TRUE,

                       title = "Plot of Mean and 95% Confidence Limits by Visit",

                       subtitle = "",

                       subtitle_add_paramcd = TRUE,

                       subtitle_add_unit = TRUE,

                       caption = NULL,

                       table_format = NULL,

                       table_labels = NULL,

                       table_font_size = 3,

                       errorbar_width = 0.45,

                       newpage = lifecycle::deprecated(),

                       col = NULL,

                       linetype = NULL) {

  }

    }

  }

  }

  }

  }

  } else {

  }

  } else {

  }

  }

  }

  }

  ####################################### |

  # ---- Compute required statistics ----

  ####################################### |

  # Remove unused levels for x-axis

  }

  } else {

  }

    )

  # add number of objects N in group_var (strata)

    # keep strata factor levels

      )]

    })

    # strata_N should not be in colnames(df_stats)

  } else {

  }

  ############################################### |

  # ---- Prepare certain plot's properties. ----

  ############################################### |

  # legend title

  }

  # y label

    }

    }

  }

  # subtitle

    }

    }

  }

  ############################### |

  # ---- Build plot object. ----

  ############################### |

    )

  )

  }

    # points

    }

    # lines - plotted only if there is a strata grouping (group_var)

    }

  }

  # interval

      )

      # workaround as geom_errorbar does not provide single-direction whiskers

        )

    }

  }

  }

    )

  }

  }

  }

  } else {

        )

      )

  }

  ############################################################# |

  # ---- Optionally, add table to the bottom of the plot. ----

  ############################################################# |

        ),

      )

      )

    ) +

      )

    }

    # align plot and table

  } else {

  }

}

#' Helper function to format the optional `g_lineplot` table

#'

#' @description `r lifecycle::badge("stable")`

#'

#' @param x (named `list`)\cr list of numerical values to be formatted and optionally labeled.

#'   Elements of `x` must be `numeric` vectors.

#' @param format (named `character` or `NULL`)\cr format patterns for `x`. Names of the `format` must

#'   match the names of `x`. This parameter is passed directly to the `rtables::format_rcell`

#'   function through the `format` parameter.

#' @param labels (named `character` or `NULL`)\cr optional labels for `x`. Names of the `labels` must

#'   match the names of `x`. When a label is not specified for an element of `x`,

#'   then this function tries to use `label` or `names` (in this order) attribute of that element

#'   (depending on which one exists and it is not `NULL` or `NA` or `NaN`). If none of these attributes

#'   are attached to a given element of `x`, then the label is automatically generated.

#'

#' @return A single row `data.frame` object.

#'

#' @examples

#' mean_ci <- c(48, 51)

#' x <- list(mean = 50, mean_ci = mean_ci)

#' format <- c(mean = "xx.x", mean_ci = "(xx.xx, xx.xx)")

#' labels <- c(mean = "My Mean")

#' h_format_row(x, format, labels)

#'

#' attr(mean_ci, "label") <- "Mean 95% CI"

#' x <- list(mean = 50, mean_ci = mean_ci)

#' h_format_row(x, format, labels)

#'

#' @export

h_format_row <- function(x, format, labels = NULL) {

  # cell: one row, one column data.frame

    }

    }

  }

    )

  )

}

#' Control function for `g_lineplot()`

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Default values for `variables` parameter in `g_lineplot` function.

#' A variable's default value can be overwritten for any variable.

#'

#' @param x (`string`)\cr x-variable name.

#' @param y (`string`)\cr y-variable name.

#' @param group_var (`string` or `NA`)\cr group variable name.

#' @param strata `r lifecycle::badge("deprecated")` use the `group_var` parameter instead.

#' @param subject_var (`string` or `NA`)\cr subject variable name.

#' @param cohort_id `r lifecycle::badge("deprecated")` use the `subject_var` parameter instead.

#' @param facet_var (`string` or `NA`)\cr faceting variable name.

#' @param paramcd (`string` or `NA`)\cr parameter code variable name.

#' @param y_unit (`string` or `NA`)\cr y-axis unit variable name.

#'

#' @return A named character vector of variable names.

#'

#' @examples

#' control_lineplot_vars()

#' control_lineplot_vars(group_var = NA)

#'

#' @export

control_lineplot_vars <- function(x = "AVISIT",

                                  y = "AVAL",

                                  group_var = "ARM",

                                  facet_var = NA,

                                  paramcd = "PARAMCD",

                                  y_unit = "AVALU",

                                  subject_var = "USUBJID",

                                  strata = lifecycle::deprecated(),

                                  cohort_id = lifecycle::deprecated()) {

  }

  }

  )

}

#' Count patients with toxicity grades that have worsened from baseline by highest grade post-baseline

#'

#' @description `r lifecycle::badge("stable")`

#'

#' The analyze function [count_abnormal_lab_worsen_by_baseline()] creates a layout element to count patients with

#' analysis toxicity grades which have worsened from baseline, categorized by highest (worst) grade post-baseline.

#'

#' This function analyzes primary analysis variable `var` which indicates analysis toxicity grades. Additional

#' analysis variables that can be supplied as a list via the `variables` parameter are `id` (defaults to `USUBJID`),

#' a variable to indicate unique subject identifiers, `baseline_var` (defaults to `BTOXGR`), a variable to indicate

#' baseline toxicity grades, and `direction_var` (defaults to `GRADDIR`), a variable to indicate toxicity grade

#' directions of interest to include (e.g. `"H"` (high), `"L"` (low), or `"B"` (both)).

#'

#' For the direction(s) specified in `direction_var`, patient counts by worst grade for patients who have

#' worsened from baseline are calculated as follows:

#'   * `1` to `4`: The number of patients who have worsened from their baseline grades with worst

#'     grades 1-4, respectively.

#'   * `Any`: The total number of patients who have worsened from their baseline grades.

#'

#' Fractions are calculated by dividing the above counts by the number of patients who's analysis toxicity grades

#' have worsened from baseline toxicity grades during treatment.

#'

#' Prior to using this function in your table layout you must use [rtables::split_rows_by()] to create a row

#' split on variable `direction_var`.

#'

#' @inheritParams argument_convention

#' @param variables (named `list` of `string`)\cr list of additional analysis variables including:

#'   * `id` (`string`)\cr subject variable name.

#'   * `baseline_var` (`string`)\cr name of the data column containing baseline toxicity variable.

#'   * `direction_var` (`string`)\cr see `direction_var` for more details.

#' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("abnormal_by_worst_grade_worsen")`

#'   to see all available statistics.

#'

#' @seealso Relevant helper functions [h_adlb_worsen()] and [h_worsen_counter()] which are used within

#' [s_count_abnormal_lab_worsen_by_baseline()] to process input data.

#'

#' @name abnormal_by_worst_grade_worsen

#' @order 1

NULL

#' Helper function to prepare ADLB with worst labs

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper function to prepare a `df` for generate the patient count shift table.

#'

#' @param adlb (`data.frame`)\cr ADLB data frame.

#' @param worst_flag_low (named `vector`)\cr worst low post-baseline lab grade flag variable. See how this is

#'   implemented in the following examples.

#' @param worst_flag_high (named `vector`)\cr worst high post-baseline lab grade flag variable. See how this is

#'   implemented in the following examples.

#' @param direction_var (`string`)\cr name of the direction variable specifying the direction of the shift table of

#'   interest. Only lab records flagged by `L`, `H` or `B` are included in the shift table.

#'   * `L`: low direction only

#'   * `H`: high direction only

#'   * `B`: both low and high directions

#'

#' @return `h_adlb_worsen()` returns the `adlb` `data.frame` containing only the

#'   worst labs specified according to `worst_flag_low` or `worst_flag_high` for the

#'   direction specified according to `direction_var`. For instance, for a lab that is

#'   needed for the low direction only, only records flagged by `worst_flag_low` are

#'   selected. For a lab that is needed for both low and high directions, the worst

#'   low records are selected for the low direction, and the worst high record are selected

#'   for the high direction.

#'

#' @seealso [abnormal_by_worst_grade_worsen]

#'

#' @examples

#' library(dplyr)

#'

#' # The direction variable, GRADDR, is based on metadata

#' adlb <- tern_ex_adlb %>%

#'   mutate(

#'     GRADDR = case_when(

#'       PARAMCD == "ALT" ~ "B",

#'       PARAMCD == "CRP" ~ "L",

#'       PARAMCD == "IGA" ~ "H"

#'     )

#'   ) %>%

#'   filter(SAFFL == "Y" & ONTRTFL == "Y" & GRADDR != "")

#'

#' df <- h_adlb_worsen(

#'   adlb,

#'   worst_flag_low = c("WGRLOFL" = "Y"),

#'   worst_flag_high = c("WGRHIFL" = "Y"),

#'   direction_var = "GRADDR"

#' )

#'

#' @export

h_adlb_worsen <- function(adlb,

                          worst_flag_low = NULL,

                          worst_flag_high = NULL,

                          direction_var) {

  }

  }

      )

    )

  }

  # extract patients with worst post-baseline lab, either low or high or both

  )

  # select variables of interest

  # generate subsets for different directionality

  # for labs requiring both high and low, data is duplicated and will be stacked on top of each other

  # extract data with worst lab

    # change H to High, L to Low

    # change, B to High and Low

  }

  # label

  # NA

}

#' Helper function to analyze patients for `s_count_abnormal_lab_worsen_by_baseline()`

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper function to count the number of patients and the fraction of patients according to

#' highest post-baseline lab grade variable `.var`, baseline lab grade variable `baseline_var`,

#' and the direction of interest specified in `direction_var`.

#'

#' @inheritParams argument_convention

#' @inheritParams h_adlb_worsen

#' @param baseline_var (`string`)\cr name of the baseline lab grade variable.

#'

#' @return The counts and fraction of patients

#'   whose worst post-baseline lab grades are worse than their baseline grades, for

#'   post-baseline worst grades "1", "2", "3", "4" and "Any".

#'

#' @seealso [abnormal_by_worst_grade_worsen]

#'

#' @examples

#' library(dplyr)

#'

#' # The direction variable, GRADDR, is based on metadata

#' adlb <- tern_ex_adlb %>%

#'   mutate(

#'     GRADDR = case_when(

#'       PARAMCD == "ALT" ~ "B",

#'       PARAMCD == "CRP" ~ "L",

#'       PARAMCD == "IGA" ~ "H"

#'     )

#'   ) %>%

#'   filter(SAFFL == "Y" & ONTRTFL == "Y" & GRADDR != "")

#'

#' df <- h_adlb_worsen(

#'   adlb,

#'   worst_flag_low = c("WGRLOFL" = "Y"),

#'   worst_flag_high = c("WGRHIFL" = "Y"),

#'   direction_var = "GRADDR"

#' )

#'

#' # `h_worsen_counter`

#' h_worsen_counter(

#'   df %>% filter(PARAMCD == "CRP" & GRADDR == "Low"),

#'   id = "USUBJID",

#'   .var = "ATOXGR",

#'   baseline_var = "BTOXGR",

#'   direction_var = "GRADDR"

#' )

#'

#' @export

h_worsen_counter <- function(df, id, .var, baseline_var, direction_var) {

  # remove post-baseline missing

  # obtain directionality

  }

      # filter baseline values that is less than i or <Missing>

      # num: number of patients with post-baseline worst lab equal to i

      # denom: number of patients with baseline values less than i or <missing> and post-baseline in the same direction

    })

  } else {

    })

  }

  # baseline grade less 4 or missing

  # denom: number of patients with baseline values less than 4 or <missing> and post-baseline in the same direction

  # condition 1: missing baseline and in the direction of abnormality

  # condition 2: if post-baseline values are present then post-baseline values must be worse than baseline

  } else {

  }

  # number of patients satisfy either conditions 1 or 2

}

#' @describeIn abnormal_by_worst_grade_worsen Statistics function for patients whose worst post-baseline

#'   lab grades are worse than their baseline grades.

#'

#' @return

#' * `s_count_abnormal_lab_worsen_by_baseline()` returns the counts and fraction of patients whose worst

#'   post-baseline lab grades are worse than their baseline grades, for post-baseline worst grades

#'   "1", "2", "3", "4" and "Any".

#'

#' @keywords internal

s_count_abnormal_lab_worsen_by_baseline <- function(df, # nolint

                                                    .var = "ATOXGR",

                                                    variables = list(

                                                      id = "USUBJID",

                                                      baseline_var = "BTOXGR",

                                                      direction_var = "GRADDR"

                                                    )) {

}

#' @describeIn abnormal_by_worst_grade_worsen Formatted analysis function which is used as `afun`

#'   in `count_abnormal_lab_worsen_by_baseline()`.

#'

#' @return

#' * `a_count_abnormal_lab_worsen_by_baseline()` returns the corresponding list with

#'   formatted [rtables::CellValue()].

#'

#' @keywords internal

a_count_abnormal_lab_worsen_by_baseline <- make_afun( # nolint

  s_count_abnormal_lab_worsen_by_baseline,

  .formats = c(fraction = format_fraction),

  .ungroup_stats = "fraction"

)

#' @describeIn abnormal_by_worst_grade_worsen Layout-creating function which can take statistics function

#'   arguments and additional format arguments. This function is a wrapper for [rtables::analyze()].

#'

#' @return

#' * `count_abnormal_lab_worsen_by_baseline()` returns a layout object suitable for passing to further layouting

#'   functions, or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted

#'   rows containing the statistics from `s_count_abnormal_lab_worsen_by_baseline()` to the table layout.

#'

#' @examples

#' library(dplyr)

#'

#' # The direction variable, GRADDR, is based on metadata

#' adlb <- tern_ex_adlb %>%

#'   mutate(

#'     GRADDR = case_when(

#'       PARAMCD == "ALT" ~ "B",

#'       PARAMCD == "CRP" ~ "L",

#'       PARAMCD == "IGA" ~ "H"

#'     )

#'   ) %>%

#'   filter(SAFFL == "Y" & ONTRTFL == "Y" & GRADDR != "")

#'

#' df <- h_adlb_worsen(

#'   adlb,

#'   worst_flag_low = c("WGRLOFL" = "Y"),

#'   worst_flag_high = c("WGRHIFL" = "Y"),

#'   direction_var = "GRADDR"

#' )

#'

#' basic_table() %>%

#'   split_cols_by("ARMCD") %>%

#'   add_colcounts() %>%

#'   split_rows_by("PARAMCD") %>%

#'   split_rows_by("GRADDR") %>%

#'   count_abnormal_lab_worsen_by_baseline(

#'     var = "ATOXGR",

#'     variables = list(

#'       id = "USUBJID",

#'       baseline_var = "BTOXGR",

#'       direction_var = "GRADDR"

#'     )

#'   ) %>%

#'   append_topleft("Direction of Abnormality") %>%

#'   build_table(df = df, alt_counts_df = tern_ex_adsl)

#'

#' @export

#' @order 2

count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint

                                                  var,

                                                  variables = list(

                                                    id = "USUBJID",

                                                    baseline_var = "BTOXGR",

                                                    direction_var = "GRADDR"

                                                  ),

                                                  na_str = default_na_str(),

                                                  nested = TRUE,

                                                  ...,

                                                  table_names = NULL,

                                                  .stats = NULL,

                                                  .formats = NULL,

                                                  .labels = NULL,

                                                  .indent_mods = NULL) {

  )

  )

}

#' Helper functions for accessing information from `rtables`

#'

#' @description `r lifecycle::badge("stable")`

#'

#' These are a couple of functions that help with accessing the data in `rtables` objects.

#' Currently these work for occurrence tables, which are defined as having a count as the first

#' element and a fraction as the second element in each cell.

#'

#' @seealso [prune_occurrences] for usage of these functions.

#'

#' @name rtables_access

NULL

#' @describeIn rtables_access Helper function to extract the first values from each content

#'   cell and from specified columns in a `TableRow`. Defaults to all columns.

#'

#' @param table_row (`TableRow`)\cr an analysis row in a occurrence table.

#' @param col_names (`character`)\cr the names of the columns to extract from.

#' @param col_indices (`integer`)\cr the indices of the columns to extract from. If `col_names` are provided,

#'   then these are inferred from the names of `table_row`. Note that this currently only works well with a single

#'   column split.

#'

#' @return

#' * `h_row_first_values()` returns a `vector` of numeric values.

#'

#' @examples

#' tbl <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("RACE") %>%

#'   analyze("AGE", function(x) {

#'     list(

#'       "mean (sd)" = rcell(c(mean(x), sd(x)), format = "xx.x (xx.x)"),

#'       "n" = length(x),

#'       "frac" = rcell(c(0.1, 0.1), format = "xx (xx)")

#'     )

#'   }) %>%

#'   build_table(tern_ex_adsl) %>%

#'   prune_table()

#' tree_row_elem <- collect_leaves(tbl[2, ])[[1]]

#' result <- max(h_row_first_values(tree_row_elem))

#' result

#'

#' @export

h_row_first_values <- function(table_row,

                               col_names = NULL,

                               col_indices = NULL) {

  # Main values are extracted

  # Main return

    } else {

    }

}

#' @describeIn rtables_access Helper function that extracts row values and checks if they are

#'   convertible to integers (`integerish` values).

#'

#' @return

#' * `h_row_counts()` returns a `vector` of numeric values.

#'

#' @examples

#' # Row counts (integer values)

#' # h_row_counts(tree_row_elem) # Fails because there are no integers

#' # Using values with integers

#' tree_row_elem <- collect_leaves(tbl[3, ])[[1]]

#' result <- h_row_counts(tree_row_elem)

#' # result

#'

#' @export

h_row_counts <- function(table_row,

                         col_names = NULL,

                         col_indices = NULL) {

}

#' @describeIn rtables_access Helper function to extract fractions from specified columns in a `TableRow`.

#'   More specifically it extracts the second values from each content cell and checks it is a fraction.

#'

#' @return

#' * `h_row_fractions()` returns a `vector` of proportions.

#'

#' @examples

#' # Row fractions

#' tree_row_elem <- collect_leaves(tbl[4, ])[[1]]

#' h_row_fractions(tree_row_elem)

#'

#' @export

h_row_fractions <- function(table_row,

                            col_names = NULL,

                            col_indices = NULL) {

}

#' @describeIn rtables_access Helper function to extract column counts from specified columns in a table.

#'

#' @param table (`VTableNodeInfo`)\cr an occurrence table or row.

#'

#' @return

#' * `h_col_counts()` returns a `vector` of column counts.

#'

#' @export

h_col_counts <- function(table,

                         col_names = NULL,

                         col_indices = NULL) {

}

#' @describeIn rtables_access Helper function to get first row of content table of current table.

#'

#' @return

#' * `h_content_first_row()` returns a row from an `rtables` table.

#'

#' @export

h_content_first_row <- function(table) {

}

#' @describeIn rtables_access Helper function which says whether current table is a leaf in the tree.

#'

#' @return

#' * `is_leaf_table()` returns a `logical` value indicating whether current table is a leaf.

#'

#' @keywords internal

is_leaf_table <- function(table) {

}

#' @describeIn rtables_access Internal helper function that tests standard inputs for column indices.

#'

#' @return

#' * `check_names_indices` returns column indices.

#'

#' @keywords internal

check_names_indices <- function(table_row,

                                col_names = NULL,

                                col_indices = NULL) {

      )

    }

  }

  }

}

#' Add titles, footnotes, page Number, and a bounding box to a grid grob

#'

#' @description `r lifecycle::badge("stable")`

#'

#' This function is useful to label grid grobs (also `ggplot2`, and `lattice` plots)

#' with title, footnote, and page numbers.

#'

#' @inheritParams grid::grob

#' @param grob (`grob`)\cr a grid grob object, optionally `NULL` if only a `grob` with the decoration should be shown.

#' @param titles (`character`)\cr titles given as a vector of strings that are each separated by a newline and wrapped

#'   according to the page width.

#' @param footnotes (`character`)\cr footnotes. Uses the same formatting rules as `titles`.

#' @param page (`string` or `NULL`)\cr page numeration. If `NULL` then no page number is displayed.

#' @param width_titles (`grid::unit`)\cr width of titles. Usually defined as all the available space

#'   `grid::unit(1, "npc")`, it is affected by the parameter `outer_margins`. Right margins (`outer_margins[4]`)

#'   need to be subtracted to the allowed width.

#' @param width_footnotes (`grid::unit`)\cr width of footnotes. Same default and margin correction as `width_titles`.

#' @param border (`flag`)\cr whether a border should be drawn around the plot or not.

#' @param padding (`grid::unit`)\cr padding. A unit object of length 4. Innermost margin between the plot (`grob`)

#'   and, possibly, the border of the plot. Usually expressed in 4 identical values (usually `"lines"`). It defaults

#'   to `grid::unit(rep(1, 4), "lines")`.

#' @param margins (`grid::unit`)\cr margins. A unit object of length 4. Margins between the plot and the other

#'   elements in the list (e.g. titles, plot, and footers). This is usually expressed in 4 `"lines"`, where the

#'   lateral ones are 0s, while top and bottom are 1s. It defaults to `grid::unit(c(1, 0, 1, 0), "lines")`.

#' @param outer_margins (`grid::unit`)\cr outer margins. A unit object of length 4. It defines the general margin of

#'   the plot, considering also decorations like titles, footnotes, and page numbers. It defaults to

#'   `grid::unit(c(2, 1.5, 3, 1.5), "cm")`.

#' @param gp_titles (`gpar`)\cr a `gpar` object. Mainly used to set different `"fontsize"`.

#' @param gp_footnotes (`gpar`)\cr a `gpar` object. Mainly used to set different `"fontsize"`.

#'

#' @return A grid grob (`gTree`).

#'

#' @details The titles and footnotes will be ragged, i.e. each title will be wrapped individually.

#'

#' @examples

#' library(grid)

#'

#' titles <- c(

#'   "Edgar Anderson's Iris Data",

#'   paste(

#'     "This famous (Fisher's or Anderson's) iris data set gives the measurements",

#'     "in centimeters of the variables sepal length and width and petal length",

#'     "and width, respectively, for 50 flowers from each of 3 species of iris."

#'   )

#' )

#'

#' footnotes <- c(

#'   "The species are Iris setosa, versicolor, and virginica.",

#'   paste(

#'     "iris is a data frame with 150 cases (rows) and 5 variables (columns) named",

#'     "Sepal.Length, Sepal.Width, Petal.Length, Petal.Width, and Species."

#'   )

#' )

#'

#' ## empty plot

#' grid.newpage()

#'

#' grid.draw(

#'   decorate_grob(

#'     NULL,

#'     titles = titles,

#'     footnotes = footnotes,

#'     page = "Page 4 of 10"

#'   )

#' )

#'

#' # grid

#' p <- gTree(

#'   children = gList(

#'     rectGrob(),

#'     xaxisGrob(),

#'     yaxisGrob(),

#'     textGrob("Sepal.Length", y = unit(-4, "lines")),

#'     textGrob("Petal.Length", x = unit(-3.5, "lines"), rot = 90),

#'     pointsGrob(iris$Sepal.Length, iris$Petal.Length, gp = gpar(col = iris$Species), pch = 16)

#'   ),

#'   vp = vpStack(plotViewport(), dataViewport(xData = iris$Sepal.Length, yData = iris$Petal.Length))

#' )

#' grid.newpage()

#' grid.draw(p)

#'

#' grid.newpage()

#' grid.draw(

#'   decorate_grob(

#'     grob = p,

#'     titles = titles,

#'     footnotes = footnotes,

#'     page = "Page 6 of 129"

#'   )

#' )

#'

#' ## with ggplot2

#' library(ggplot2)

#'

#' p_gg <- ggplot2::ggplot(iris, aes(Sepal.Length, Sepal.Width, col = Species)) +

#'   ggplot2::geom_point()

#' p_gg

#' p <- ggplotGrob(p_gg)

#' grid.newpage()

#' grid.draw(

#'   decorate_grob(

#'     grob = p,

#'     titles = titles,

#'     footnotes = footnotes,

#'     page = "Page 6 of 129"

#'   )

#' )

#'

#' ## with lattice

#' library(lattice)

#'

#' xyplot(Sepal.Length ~ Petal.Length, data = iris, col = iris$Species)

#' p <- grid.grab()

#' grid.newpage()

#' grid.draw(

#'   decorate_grob(

#'     grob = p,

#'     titles = titles,

#'     footnotes = footnotes,

#'     page = "Page 6 of 129"

#'   )

#' )

#'

#' # with gridExtra - no borders

#' library(gridExtra)

#' grid.newpage()

#' grid.draw(

#'   decorate_grob(

#'     tableGrob(

#'       head(mtcars)

#'     ),

#'     titles = "title",

#'     footnotes = "footnote",

#'     border = FALSE

#'   )

#' )

#'

#' @export

decorate_grob <- function(grob,

                          titles,

                          footnotes,

                          page = "",

                          width_titles = grid::unit(1, "npc"),

                          width_footnotes = grid::unit(1, "npc"),

                          border = TRUE,

                          padding = grid::unit(rep(1, 4), "lines"),

                          margins = grid::unit(c(1, 0, 1, 0), "lines"),

                          outer_margins = grid::unit(c(2, 1.5, 3, 1.5), "cm"),

                          gp_titles = grid::gpar(),

                          gp_footnotes = grid::gpar(fontsize = 8),

                          name = NULL,

                          gp = grid::gpar(),

                          vp = NULL) {

  # External margins need to be taken into account when defining the width of titles and footers

  # because the text is split in advance depending on only the width of the viewport.

  }

  )

  )

  )

  # Initial decoration of the grob -> border, paddings, and margins are used here

        ),

      )

    ),

    )

  )

        ),

              )

            )

          )

        )

      )

    ),

  )

}

# nocov start

#' @importFrom grid validDetails

#' @noRd

validDetails.decoratedGrob <- function(x) {

  checkmate::assert_character(x$titles)

  checkmate::assert_character(x$footnotes)

  if (!is.null(x$grob)) {

    checkmate::assert_true(grid::is.grob(x$grob))

  }

  if (length(x$page) == 1) {

    checkmate::assert_character(x$page)

  }

  if (!grid::is.unit(x$outer_margins)) {

    checkmate::assert_vector(x$outer_margins, len = 4)

  }

  if (!grid::is.unit(x$margins)) {

    checkmate::assert_vector(x$margins, len = 4)

  }

  if (!grid::is.unit(x$padding)) {

    checkmate::assert_vector(x$padding, len = 4)

  }

  x

}

#' @importFrom grid widthDetails

#' @noRd

widthDetails.decoratedGrob <- function(x) {

  grid::unit(1, "null")

}

#' @importFrom grid heightDetails

#' @noRd

heightDetails.decoratedGrob <- function(x) {

  grid::unit(1, "null")

}

#' Split text according to available text width

#'

#' Dynamically wrap text.

#'

#' @inheritParams grid::grid.text

#' @param text (`string`)\cr the text to wrap.

#' @param width (`grid::unit`)\cr a unit object specifying maximum width of text.

#'

#' @return A text `grob`.

#'

#' @details This code is taken from `R Graphics by Paul Murell, 2nd edition`

#'

#' @keywords internal

split_text_grob <- function(text,

                            x = grid::unit(0.5, "npc"),

                            y = grid::unit(0.5, "npc"),

                            width = grid::unit(1, "npc"),

                            just = "centre",

                            hjust = NULL,

                            vjust = NULL,

                            default.units = "npc", # nolint

                            name = NULL,

                            gp = grid::gpar(),

                            vp = NULL) {

  text <- paste0(text, collapse = "\n") # necessary for c("", "a a")

  if (!grid::is.unit(x)) x <- grid::unit(x, default.units)

  if (!grid::is.unit(y)) y <- grid::unit(y, default.units)

  if (!grid::is.unit(width)) width <- grid::unit(width, default.units)

  if (grid::unitType(x) %in% c("sum", "min", "max")) x <- grid::convertUnit(x, default.units)

  if (grid::unitType(y) %in% c("sum", "min", "max")) y <- grid::convertUnit(y, default.units)

  if (grid::unitType(width) %in% c("sum", "min", "max")) width <- grid::convertUnit(width, default.units)

  if (length(gp) > 0) { # account for effect of gp on text width -> it was bugging when text was empty

    width <- width * grid::convertWidth(grid::grobWidth(grid::textGrob(text)), "npc", valueOnly = TRUE) /

      grid::convertWidth(grid::grobWidth(grid::textGrob(text, gp = gp)), "npc", valueOnly = TRUE)

  }

  ## if it is a fixed unit then we do not need to recalculate when viewport resized

  if (!inherits(width, "unit.arithmetic") && !is.null(attr(width, "unit")) &&

    attr(width, "unit") %in% c("cm", "inches", "mm", "points", "picas", "bigpts", "dida", "cicero", "scaledpts")) { # nolint